home *** CD-ROM | disk | FTP | other *** search
/ CICA 1993 April / CICA MS Windows - April 1993.iso / unzipped / programr / tp / tpwmi2 / frames.pas < prev    next >
Pascal/Delphi Source File  |  1992-08-12  |  9KB  |  296 lines
  1. { Frames unit - a set of comprehensive (for my purposes) functions for
  2.     drawing pretty 3-D frames of all types. Pretty simple stuff - I'm sure
  3.     you will be able to figure it out - but that's why I included it.
  4.     As always, you are welcome to do whatever with this unit. I only ask that
  5.     if you upload it somewhere modified, keep my name off it, so I don't have
  6.     to answer for your bad code <grin>. If you have any suggestions or
  7.     questions, by all means send them to me - I'd love to hear from a fellow
  8.     programmer.
  9.         Steve Willer
  10.         Mark Data Management
  11.         CIS: 70400,3667
  12.         AOL: SteveWill
  13. }
  14.  
  15. unit frames;
  16.  
  17. interface
  18. uses WinTypes,WinProcs,WinDOS;
  19. procedure DrawBorderFrame(PaintDC:HDC;PaintR:TRect;Back:boolean);
  20. procedure DrawOutFrame(PaintDC:HDC;PaintR:TRect;Back:boolean;Width:integer);
  21. procedure DrawInFrame(PaintDC:HDC;PaintR:TRect;Back:boolean;Width:integer);
  22. procedure DrawDivLine(PaintDC:HDC;Y:integer;Width:integer);
  23. procedure DrawDotLine(PaintDC:HDC;PaintR:TRect;Incr:integer);
  24. function MakeBorBrush(HWindow:HWnd;BackColor1,BackColor2:TColorRef):HBrush;
  25. procedure DrawExplodeFrame(PaintDC:HDC;ExplR:TRect;PenColor,BrushColor:TColorRef;DrawBrush:boolean;Width:integer;
  26.                 Steps:integer;Pause:longint);
  27.  
  28. implementation
  29. procedure DrawBorderFrame(PaintDC:HDC;PaintR:TRect;Back:boolean);
  30. var ThePen,OldPen:HPen;
  31.         FillBrush,OldBrush:HBrush;
  32. begin
  33.     if Back then
  34.     begin
  35.         FillBrush := CreateSolidBrush($00C0C0C0);
  36.         OldBrush := SelectObject(PaintDC,FillBrush);
  37.         InflateRect(PaintR,-1,-1);
  38.         FillRect(PaintDC,PaintR,FillBrush);
  39.         InflateRect(PaintR,1,1);
  40.         SelectObject(PaintDC,OldBrush);
  41.         DeleteObject(FillBrush);
  42.     end;
  43.  
  44.     OldBrush := SelectObject(PaintDC,GetStockObject(Null_Brush));
  45.     ThePen := CreatePen(ps_Solid,1,$00C0C0C0);
  46.     OldPen := SelectObject(PaintDC,ThePen);
  47.     PaintR.top:=PaintR.top+1;
  48.     PaintR.left:=PaintR.left-1;
  49.     Rectangle(PaintDC,PaintR.left,PaintR.top,PaintR.right,PaintR.bottom);
  50.     PaintR.top:=PaintR.top-1;
  51.     PaintR.left:=PaintR.left+1;
  52.     SelectObject(PaintDC,OldPen);
  53.     DeleteObject(ThePen);
  54.     SelectObject(PaintDC,OldBrush);
  55.  
  56.     ThePen := CreatePen(ps_Solid,1,RGB(255,255,255));
  57.     OldPen := SelectObject(PaintDC,ThePen);
  58.     MoveTo(PaintDC,PaintR.right,PaintR.top);
  59.     LineTo(PaintDC,PaintR.left,PaintR.top);
  60.     LineTo(PaintDC,PaintR.left,PaintR.bottom);
  61.     MoveTo(PaintDC,PaintR.left+2,PaintR.bottom-2);
  62.     LineTo(PaintDC,PaintR.right-2,PaintR.bottom-2);
  63.     LineTo(PaintDC,PaintR.right-2,PaintR.top+2);
  64.     SelectObject(PaintDC,OldPen);
  65.     DeleteObject(ThePen);
  66.  
  67.     ThePen := CreatePen(ps_Solid,1,RGB(127,127,127));
  68.     OldPen := SelectObject(PaintDC,ThePen);
  69.     MoveTo(PaintDC,PaintR.right-2,PaintR.top+2);
  70.     LineTo(PaintDC,PaintR.left+2,PaintR.top+2);
  71.     LineTo(PaintDC,PaintR.left+2,PaintR.bottom-3);
  72.     MoveTo(PaintDC,PaintR.left,PaintR.bottom);
  73.     LineTo(PaintDC,PaintR.right,PaintR.bottom);
  74.     LineTo(PaintDC,PaintR.right,PaintR.top);
  75.     SelectObject(PaintDC,OldPen);
  76.     DeleteObject(ThePen);
  77. end;
  78.  
  79. procedure DrawOutFrame(PaintDC:HDC;PaintR:TRect;Back:boolean;Width:integer);
  80. var ThePen,OldPen:HPen;
  81.         FillBrush,OldBrush:HBrush;
  82.         count:integer;
  83.         CalcR:TRect;
  84. begin
  85.     if Back then
  86.     begin
  87.         FillBrush := CreateSolidBrush($00C0C0C0);
  88.         OldBrush := SelectObject(PaintDC,FillBrush);
  89.         InflateRect(PaintR,-1*(Width)+1,-1*(Width)+1);
  90.         FillRect(PaintDC,PaintR,FillBrush);
  91.         InflateRect(PaintR,Width-1,Width-1);
  92.         SelectObject(PaintDC,OldBrush);
  93.         DeleteObject(FillBrush);
  94.     end;
  95.  
  96.     CalcR:=PaintR;
  97.  
  98.     for count:=0 to (Width-1) do
  99.     begin
  100.         PaintR:=CalcR;
  101.         InflateRect(PaintR,-1*(count),-1*(count));
  102.  
  103.         ThePen := CreatePen(ps_Solid,1,RGB(255,255,255));
  104.         OldPen := SelectObject(PaintDC,ThePen);
  105.         MoveTo(PaintDC,PaintR.right,PaintR.top);
  106.         LineTo(PaintDC,PaintR.left,PaintR.top);
  107.         LineTo(PaintDC,PaintR.left,PaintR.bottom+1);
  108.         SelectObject(PaintDC,OldPen);
  109.         DeleteObject(ThePen);
  110.  
  111.         ThePen := CreatePen(ps_Solid,1,RGB(127,127,127));
  112.         OldPen := SelectObject(PaintDC,ThePen);
  113.         MoveTo(PaintDC,PaintR.right,PaintR.top+1);
  114.         LineTo(PaintDC,PaintR.right,PaintR.bottom);
  115.         LineTo(PaintDC,PaintR.left,PaintR.bottom);
  116.         SelectObject(PaintDC,OldPen);
  117.         DeleteObject(ThePen);
  118.  
  119.     end;
  120. end;
  121.  
  122. procedure DrawInFrame(PaintDC:HDC;PaintR:TRect;Back:boolean;Width:integer);
  123. var ThePen,OldPen:HPen;
  124.         FillBrush,OldBrush:HBrush;
  125.         count:integer;
  126.         CalcR:TRect;
  127. begin
  128.     if Back then
  129.     begin
  130.         FillBrush := CreateSolidBrush($00C0C0C0);
  131.         OldBrush := SelectObject(PaintDC,FillBrush);
  132.         InflateRect(PaintR,-1*(Width)+1,-1*(Width)+1);
  133.         FillRect(PaintDC,PaintR,FillBrush);
  134.         InflateRect(PaintR,Width-1,Width-1);
  135.         SelectObject(PaintDC,OldBrush);
  136.         DeleteObject(FillBrush);
  137.     end;
  138.  
  139.     CalcR:=PaintR;
  140.  
  141.     for count:=0 to (Width-1) do
  142.     begin
  143.         PaintR:=CalcR;
  144.         InflateRect(PaintR,-1*(count),-1*(count));
  145.  
  146.         ThePen := CreatePen(ps_Solid,1,RGB(127,127,127));
  147.         OldPen := SelectObject(PaintDC,ThePen);
  148.         MoveTo(PaintDC,PaintR.right,PaintR.top);
  149.         LineTo(PaintDC,PaintR.left,PaintR.top);
  150.         LineTo(PaintDC,PaintR.left,PaintR.bottom);
  151.         SelectObject(PaintDC,OldPen);
  152.         DeleteObject(ThePen);
  153.  
  154.         ThePen := CreatePen(ps_Solid,1,RGB(255,255,255));
  155.         OldPen := SelectObject(PaintDC,ThePen);
  156.         MoveTo(PaintDC,PaintR.right,PaintR.top+1);
  157.         LineTo(PaintDC,PaintR.right,PaintR.bottom);
  158.         LineTo(PaintDC,PaintR.left-1,PaintR.bottom);
  159.         SelectObject(PaintDC,OldPen);
  160.         DeleteObject(ThePen);
  161.     end;
  162. end;
  163.  
  164. procedure DrawDivLine(PaintDC:HDC;Y:integer;Width:integer);
  165. var ThePen,OldPen:HPen;
  166.         FillBrush,OldBrush:HBrush;
  167.         count:integer;
  168. begin
  169.         ThePen := CreatePen(ps_Solid,Width,RGB(127,127,127));
  170.         OldPen := SelectObject(PaintDC,ThePen);
  171.         MoveTo(PaintDC,GetSystemMetrics(sm_CXScreen),Y);
  172.         LineTo(PaintDC,0,Y);
  173.         SelectObject(PaintDC,OldPen);
  174.         DeleteObject(ThePen);
  175.         Y:=Y+Width;
  176.         ThePen := CreatePen(ps_Solid,Width,RGB(255,255,255));
  177.         OldPen := SelectObject(PaintDC,ThePen);
  178.         MoveTo(PaintDC,GetSystemMetrics(sm_CXScreen),Y);
  179.         LineTo(PaintDC,0,Y);
  180.         SelectObject(PaintDC,OldPen);
  181.         DeleteObject(ThePen);
  182. end;
  183.  
  184. procedure DrawDotLine(PaintDC:HDC;PaintR:TRect;Incr:integer);
  185. var ROP2:integer;
  186.         count:integer;
  187. begin
  188.     ROP2 := GetROP2(PaintDC);
  189.     SetROP2(PaintDC,r2_Not);
  190.     count := PaintR.left;
  191.     while count < PaintR.right-1 do
  192.         begin
  193.             SetPixel(PaintDC,count,PaintR.top,$00000000);
  194.             SetPixel(PaintDC,count,PaintR.bottom-1,$00000000);
  195.             count := count + Incr;
  196.         end;
  197.     count := PaintR.top+2;
  198.     while count < PaintR.bottom-1 do
  199.         begin
  200.             SetPixel(PaintDC,PaintR.left,count,$00000000);
  201.             SetPixel(PaintDC,PaintR.right-1,count,$00000000);
  202.             count := count + Incr;
  203.         end;
  204.     SetROP2(PaintDC,ROP2);
  205. end;
  206.  
  207.  
  208. function MakeBorBrush(HWindow:HWnd;BackColor1,BackColor2:TColorRef):HBrush;
  209. var DC,MemDC:HDC;
  210.         Bits:HBitmap;
  211.         FillR:TRect;
  212.         TheBrush,OldBrush:HBrush;
  213. begin
  214.     DC:=CreateDC('display',nil,nil,nil);
  215.     MemDC:=CreateCompatibleDC(DC);
  216.     Bits:=CreateCompatibleBitmap(DC,8,8);
  217.     SelectObject(MemDC,Bits);
  218.     if Bits<>0 then
  219.     begin
  220.         TheBrush:=CreateSolidBrush(GetNearestColor(DC,BackColor2));
  221.         OldBrush:=SelectObject(MemDC,TheBrush);
  222.         PatBlt(MemDC,0,0,8,8,Blackness);
  223.         with FillR do begin
  224.             left:=0;right:=8;top:=0;bottom:=8;
  225.         end;
  226.         FillRect(MemDC,FillR,TheBrush);
  227.         SelectObject(MemDC,OldBrush);
  228.         DeleteObject(TheBrush);
  229.         SetPixel(MemDC,0,0,BackColor1);
  230.         SetPixel(MemDC,0,2,BackColor1);
  231.         SetPixel(MemDC,0,4,BackColor1);
  232.         SetPixel(MemDC,0,6,BackColor1);
  233.         SetPixel(MemDC,2,0,BackColor1);
  234.         SetPixel(MemDC,2,2,BackColor1);
  235.         SetPixel(MemDC,2,4,BackColor1);
  236.         SetPixel(MemDC,2,6,BackColor1);
  237.         SetPixel(MemDC,4,0,BackColor1);
  238.         SetPixel(MemDC,4,2,BackColor1);
  239.         SetPixel(MemDC,4,4,BackColor1);
  240.         SetPixel(MemDC,4,6,BackColor1);
  241.         SetPixel(MemDC,6,0,BackColor1);
  242.         SetPixel(MemDC,6,2,BackColor1);
  243.         SetPixel(MemDC,6,4,BackColor1);
  244.         SetPixel(MemDC,6,6,BackColor1);
  245.         MakeBorBrush:=CreatePatternBrush(Bits);
  246.     end else MakeBorBrush:=0;
  247.     DeleteDC(MemDC);
  248.     DeleteDC(DC);
  249.     DeleteObject(Bits);
  250. end;
  251.  
  252. procedure DrawExplodeFrame(PaintDC:HDC;ExplR:TRect;PenColor,BrushColor:TColorRef;DrawBrush:boolean;Width:integer;
  253.             Steps:integer;Pause:longint);
  254. var    count:integer;
  255.         dX,dY:double;
  256.         ThePen,OldPen:HPen;
  257.         TheBrush,OldBrush:HBrush;
  258.         OrigR:TRect;
  259.         TimeCount:longint;
  260. begin
  261.     ThePen := CreatePen(ps_Dot,Width,PenColor);
  262.     OldPen := SelectObject(PaintDC,ThePen);
  263.     if DrawBrush then
  264.         TheBrush:=CreateSolidBrush(BrushColor) else
  265.         TheBrush := GetStockObject(Null_Brush);
  266.     OldBrush:= SelectObject(PaintDC,TheBrush);
  267.     dY:=(ExplR.bottom-ExplR.top)/Steps;
  268.     dX:=(ExplR.right-ExplR.left)/Steps;
  269.     with ExplR do
  270.     begin
  271.         left:=left+((right-left) div 2);
  272.         top:=top+((bottom-top) div 2);
  273.         right:=left;bottom:=top;
  274.     end;
  275.     OrigR:=ExplR;
  276.     for count:=1 to steps do
  277.     begin
  278.         with ExplR do
  279.         begin
  280.             TimeCount := GetTickCount;
  281.             left:=OrigR.left-integer(Round(dX*count));
  282.             right:=OrigR.right+integer(Round(dX*count));
  283.             bottom:=OrigR.bottom-integer(Round(dY*count));
  284.             top:=OrigR.top+integer(Round(dY*count));
  285.             Rectangle(PaintDC,left,top,right,bottom);
  286.             while (GetTickCount - TimeCount) < Pause do begin end;
  287.         end;
  288.     end;
  289.     SelectObject(PaintDC,OldBrush);
  290.     DeleteObject(TheBrush);
  291.     SelectObject(PaintDC,OldPen);
  292.     DeleteObject(ThePen);
  293. end;
  294.  
  295. begin
  296. end.